---
title: "Dynamically Customizable Plotly"
author: "Mayank Tandon"
output: 
  # html_document
  flexdashboard::flex_dashboard:
    source_code: embed
    theme: bootstrap

---

```{r setup, include=FALSE}
library(plotly)
library(flexdashboard)

# render list this: rmarkdown::render("customizable_plotly.Rmd",output_format="all", output_file="customizable_plotly")
make_customizable_plotly <- function(my_dataframe,      ## Data frame with data
                                     sort_by_cor=F,     ## Whether or not to sort the order of the options by correlation; can be TRUE/FALSE or a correlation method supported by 'cor()'
                                     # color_var=NULL,    ## Column name in 'my_dataframe' with data to color by
                                     id_var=NULL,   ## Column name to use for ID in hover text
                                     plot3D=F,
                                     my_title="",
                                     pointsize=10,
                                     plotwidth=800, plotheight=600) {
  # my_dataframe <- alldata
  colnames(my_dataframe) <- make.names(colnames(my_dataframe), unique=T)  ## Make syntactically correct colnames, otherwise plotly freaks out

  ## Figure out whether or not to sort by correlation
  cormeths=c("pearson","spearman","kendall")
  if (is.logical(sort_by_cor)) {
    meth=cormeths[1]
  } else if (sort_by_cor %in% cormeths) {
    meth=sort_by_cor
    sort_by_cor=TRUE
  } else {
    stop("'sort_by_cor' must be TRUE/FALSE or one of c('pearson','spearman','kendall')")
  }
  
  # Columns included in the dropdown
  varnames <- colnames(my_dataframe)
  
  # Determine which columns are numeric
  numeric_col=rep(FALSE, ncol(my_dataframe))
  for (i in 1:ncol(my_dataframe)) {
    numeric_col[i] <- is.numeric(my_dataframe[,i])
  }
  
  # if you request that the column order be sorted by correlation, 
  #   only numeric columns are used
  if (sort_by_cor) {
    num_data <- my_dataframe[, numeric_col]
    if (ncol(num_data) < 2) {
      warning("Couldn't find 2 or more numeric columns.")
    } else {
      pairwise_corr <- cor(num_data, method=meth)
      ordered_columns <- rownames(pairwise_corr)[order(abs(pairwise_corr[,1]), decreasing = T)]
      varnames <- c(ordered_columns, setdiff(varnames, ordered_columns))  ## Add back the non-numeric column names
    }
  }
  
  # Prettify the names a bit for display
  names(varnames) <- tools::toTitleCase(gsub("_|\\.", " ", varnames))
  
  # This df holds column names and prettified labels
  my_col_order <- data.frame(column_name=factor(varnames, levels = varnames),
                             column_label=factor(names(varnames), levels = names(varnames)))
  
  # Enumerate drop-down options
  #### THIS IS SUPER UGLY
  # I tried writing functions to build some of these args programmatically
  #   but I couldn't figure out a smart way
  # Also the 'list' structure has be to EXACTLY right or plotly fails silently
  
  # This shifts the column names for x, y, and z so they're pointing at different variables on initialization
  color_dropdown_opts <- rep(list(NA), nrow(my_col_order))
  x_dropdown_opts <- rep(list(NA), nrow(my_col_order))
  shifted_y <- rbind(my_col_order[2:nrow(my_col_order),], my_col_order[1,])
  y_dropdown_opts <- rep(list(NA), nrow(shifted_y))
  shifted_z <- rbind(shifted_y[2:nrow(shifted_y),], shifted_y[1,])
  z_dropdown_opts <- rep(list(NA), nrow(shifted_z))
  
  for (i in 1:nrow(my_col_order)) {
    curr_col = as.character(my_col_order$column_name)[i]
    curr_label = as.character(my_col_order$column_label)[i]
    curr_ycol = as.character(shifted_y$column_name[i])
    curr_ylabel = as.character(shifted_y$column_label[i])
    curr_zcol = as.character(shifted_z$column_name[i])
    curr_zlabel = as.character(shifted_z$column_label[i])

    color_arg <- list(marker = list(color = as.formula(paste0("~",curr_col)),
                                    size = pointsize))
    if (!numeric_col[i]) {
      ###### THIS IS NOT WORKING IDK WHY!
      ## But this at least makes the color black, instead of doing nothing
      color_arg <- list(color = as.formula(paste0("~",curr_col)))
    }
    color_dropdown_opts[[i]] <- list(method = "update",
                                  args = list(
                                    color_arg,
                                    list(showlegend = TRUE)
                                  ),
                                  label = curr_label)
    if (plot3D) {
      ## Gah! Setting one axis label resets the others!!!!
      x_dropdown_opts[[i]] <- list(method = "update",
                                args = list(list(x = list(as.formula(paste0("~",curr_col)))),
                                            list(scene = list(xaxis = list(title = curr_label)))
                                ),
                                label = curr_label)
      
      y_dropdown_opts[[i]] <- list(method = "update",
                                args = list(list(y = list(as.formula(paste0("~",curr_ycol)))),
                                            list(scene = list(yaxis = list(title = curr_ylabel)))
                                ),
                                label = curr_ylabel)
      
      z_dropdown_opts[[i]] <- list(method = "update",
                                args = list(list(z = list(as.formula(paste0("~",curr_zcol)))),
                                            list(scene = list(zaxis = list(title = curr_zlabel)))
                                ),
                                label = curr_zlabel)
    } else {
      ## But for 2D it works as expected (when one axis label is changed, the other remains the same)
      x_dropdown_opts[[i]] <- list(method = "update",
                                args = list(list(x = list(as.formula(paste0("~",curr_col)))),
                                            list(xaxis = list(title = curr_label))
                                ),
                                label = curr_label)
      
      y_dropdown_opts[[i]] <- list(method = "update",
                                args = list(list(y = list(as.formula(paste0("~",curr_ycol)))),
                                            list(yaxis = list(title = curr_ylabel))
                                ),
                                label = curr_ylabel)
      
      z_dropdown_opts[[i]] <- list(method = "update",
                                args = list(list(z = list(as.formula(paste0("~",curr_zcol)))),
                                            list(zaxis = list(title = curr_zlabel))
                                ),
                                label = curr_zlabel)
      
    }
    
  }
  
  color_dropdown_opts <- color_dropdown_opts[numeric_col]
  color_dropdown_opts[[i+1]] <- list(method = "update",
                                args = list(
                                  list(marker = list(color = as.formula("~default_color"),
                                                     size = pointsize))
                                ),
                                label = "None")
  color_dropdown_opts <- c(color_dropdown_opts[length(color_dropdown_opts)],color_dropdown_opts[1:(length(color_dropdown_opts)-1)])
  
  # Add some columns to data frame before plotting
  data_for_plotly <- as.data.frame(my_dataframe)
  data_for_plotly$default_color <- "foo"
  id_vec <- row.names(data_for_plotly)
  if (!is.null(id_var)) {
    if (id_var %in% colnames(data_for_plotly)) {
      id_vec <- as.character(data_for_plotly[, id_var])
    }
  }
  data_for_plotly$hoverid <- id_vec
  
  # Set z data as appropriate
  zval <- NULL
  charttype <- "scatter"
  if (plot3D) {
    zval <- as.formula(paste0("~",as.character(my_col_order$column_name)[3]))
    charttype <- "scatter3d"
  }
  # Make base plot
  p <- plot_ly(data=data_for_plotly, 
               x = as.formula(paste0("~",as.character(my_col_order$column_name)[1])),
               y = as.formula(paste0("~",as.character(my_col_order$column_name)[2])),
               z = zval,
               marker = list(color = as.formula("~default_color"),
                             size = pointsize),
               text=~hoverid,
               hovertemplate = paste(
                      "%{text}

",
                      "%{yaxis.title.text}: %{y}
",
                      "%{xaxis.title.text}: %{x}
",
                      ""
                      ),
               width=plotwidth, height=plotheight,
               type = charttype, mode="markers")
  
  # Set up for adding drop-down buttons
  dropdown_ylocs <- seq(0.2, 0.6, length.out = 3)
  names(dropdown_ylocs) <- rev(c("x","y","z"))
  all_buttons_list <- list(
        list(
          x=-0.2,
          y = 0.9,
          buttons = color_dropdown_opts
        ),
        list(
          x=-0.2,
          y = dropdown_ylocs["x"],
          buttons = x_dropdown_opts
        ),
        list(
          x=-0.2,
          y = dropdown_ylocs["y"],
          buttons = y_dropdown_opts
        ),
        list(
          x=-0.2,
          y = dropdown_ylocs["z"],
          buttons = z_dropdown_opts
        )
    )
  ann_list <- list(
        list(text="Color by", showarrow=FALSE, xref="paper", yref="paper", x=-0.25, y = 0.9*1.05),
        list(text="X-Axis", showarrow=FALSE, xref="paper", yref="paper", x=-0.25, y=dropdown_ylocs["x"]*1.05),
        list(text="Y-Axis", showarrow=FALSE, xref="paper", yref="paper", x=-0.25, y=dropdown_ylocs["y"]*1.05),
        list(text="Z-Axis", showarrow=FALSE, xref="paper", yref="paper", x=-0.25, y=dropdown_ylocs["z"]*1.05)
      )
  if (!plot3D) {
    all_buttons_list <- all_buttons_list[-length(all_buttons_list)]
    ann_list <- ann_list[-length(ann_list)]
  }
  
  # Add drop-down menu buttons
  if (plot3D) {
    p <- p %>%
    layout(
      autosize = F,
      title = my_title,
      scene = list(
        xaxis = list(title = as.character(my_col_order$column_name)[1]),
        yaxis = list(title = as.character(my_col_order$column_name)[2]),
        zaxis = list(title = as.character(my_col_order$column_name)[3])
      ),
      updatemenus = all_buttons_list,
      annotations = ann_list
    )
  
  } else {
    p <- p %>%
      layout(
        autosize = F,
        title = my_title,
        xaxis = list(title = as.character(my_col_order$column_name)[1]),
        yaxis = list(title = as.character(my_col_order$column_name)[2]),
        updatemenus = all_buttons_list,
        annotations = ann_list
      )
  }
  
  
  
  return(p)
  
}



```
quakes
=====================================  

Column {data-width=200, data-height=1000}
-------------------------------------
### Define some data
```{r}
library(datasets)

DATASETNAME="quakes"
alldata <- eval(parse(text=DATASETNAME))

dataset_details <- data()$results
my_details <- dataset_details[dataset_details[,"Item"]==DATASETNAME,c("Item","Title")]
names(my_details) <- c("Dataset","Description")
my_details["Rows"]<- prettyNum(nrow(alldata),big.mark = ",")
my_details["Columns"] <- prettyNum(ncol(alldata),big.mark = ",")
my_details["Total_DataPoints"] <- prettyNum(nrow(alldata)*ncol(alldata),big.mark = ",")

for (i in 1:length(my_details)) {
  writeLines(c(paste0(names(my_details)[i],":"),paste0("\t",my_details[i])))
}

writeLines("Citation:")
citation("datasets")

```


Column {.tabset}
-------------------------------------
### 2-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T)
```

### 3-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T, plot3D=T, plotwidth = 1000, plotheight=800)
```

mtcars
=====================================  

Column {data-width=200, data-height=1000}
-------------------------------------
### Define some data
```{r}
library(datasets)

DATASETNAME="mtcars"
alldata <- eval(parse(text=DATASETNAME))

dataset_details <- data()$results
my_details <- dataset_details[dataset_details[,"Item"]==DATASETNAME,c("Item","Title")]
names(my_details) <- c("Dataset","Description")
my_details["Rows"]<- prettyNum(nrow(alldata),big.mark = ",")
my_details["Columns"] <- prettyNum(ncol(alldata),big.mark = ",")
my_details["Total_DataPoints"] <- prettyNum(nrow(alldata)*ncol(alldata),big.mark = ",")

for (i in 1:length(my_details)) {
  writeLines(c(paste0(names(my_details)[i],":"),paste0("\t",my_details[i])))
}

writeLines("Citation:")
citation("datasets")

```


Column {.tabset}
-------------------------------------
### 2-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T)
```

### 3-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T, plot3D=T, plotwidth = 1000, plotheight=800)
```

Seatbelts
=====================================  

Column {data-width=200, data-height=1000}
-------------------------------------
### Define some data
```{r}
library(datasets)

DATASETNAME="Seatbelts"
alldata <- eval(parse(text=DATASETNAME))

dataset_details <- data()$results
my_details <- dataset_details[dataset_details[,"Item"]==DATASETNAME,c("Item","Title")]
names(my_details) <- c("Dataset","Description")
my_details["Rows"]<- prettyNum(nrow(alldata),big.mark = ",")
my_details["Columns"] <- prettyNum(ncol(alldata),big.mark = ",")
my_details["Total_DataPoints"] <- prettyNum(nrow(alldata)*ncol(alldata),big.mark = ",")

for (i in 1:length(my_details)) {
  writeLines(c(paste0(names(my_details)[i],":"),paste0("\t",my_details[i])))
}

writeLines("Citation:")
citation("datasets")

```


Column {.tabset}
-------------------------------------
### 2-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T)
```

### 3-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T, plot3D=T, plotwidth = 1000, plotheight=800)
```

airquality
=====================================  

Column {data-width=200, data-height=1000}
-------------------------------------
### Define some data
```{r}
library(datasets)

DATASETNAME="airquality"
alldata <- eval(parse(text=DATASETNAME))

dataset_details <- data()$results
my_details <- dataset_details[dataset_details[,"Item"]==DATASETNAME,c("Item","Title")]
names(my_details) <- c("Dataset","Description")
my_details["Rows"]<- prettyNum(nrow(alldata),big.mark = ",")
my_details["Columns"] <- prettyNum(ncol(alldata),big.mark = ",")
my_details["Total_DataPoints"] <- prettyNum(nrow(alldata)*ncol(alldata),big.mark = ",")

for (i in 1:length(my_details)) {
  writeLines(c(paste0(names(my_details)[i],":"),paste0("\t",my_details[i])))
}

writeLines("Citation:")
citation("datasets")

```


Column {.tabset}
-------------------------------------
### 2-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T)
```

### 3-D plot
```{r}
## Custom function, check Rmd for code
make_customizable_plotly(alldata, sort_by_cor=T, plot3D=T, plotwidth = 1000, plotheight=800)
```